perm filename FONTS.SAI[PUB,TES]4 blob
sn#150107 filedate 1975-03-11 generic text, type T, neo UTF8
00100 BEGOF("FONTS")
00200
00300 IFC PASSONE THENC
00400
00500 COMMENT
00600
00700 *** Variations at Different Sites ***
00800
00900 Font file formats differ at each site. Default device parameters
01000 (mostly specified in PUBDFS.SAI and COMDFS.SAI, but partly in
01100 SETDEVICEPARAMETERS) also differ. Character width checking is only
01200 enabled at some sites (XLENGTH).
01300
01400
01500 ***
01600
01700
01800 This module handles device characteristics, fonts, pichars, and
01900 raster measurements. Some of it is shared by passes one and two, but
02000 most of it is for pass one only.
02100
02200 The trickiest thing is the font numbering system. There are three
02300 numbering systems: the one in the FONT declaration (one character 0-9
02400 A-F), the one used to index arrays (0-16), and the one expected by
02500 the device (varies). Yechh!
02600
02700 ;
02800
02900 ENDC
03000
03100 IFCR PARCVER THENC
03200 DEFINE MAXNEQUIVS = [100] ;
03300 INTEGER NEQUIVS ;
03400 OWN STRING ARRAY EQUIV[1:MAXNEQUIVS, 2:4] ;
03500 ENDC
03600
03700 PROCEDURES
00100 IFK PASSONE THENK
00200 PUBLIC SIMPLE PROCEDURE FONTS! ;$"#
00300 BEGIN "FONTS!"
00400 WCW ← WHATIS(CW) ; COMMENT original font ;
00500 THISFONT ← OLDFONT ← DEFAULTFONT ;
00600 FSFONT ← DEFAULTFONT ; TES 11/29/73 ;
00700 LOFONT ← 99 ; HIFONT ← 0 ; TES 8/24/74 ;
00800 ODDLEFTBORDER ← ODDLEFTBORDERDEFAULT ; EVENLEFTBORDER ← EVENLEFTBORDERDEFAULT ; TES 8/21/74 ;
00900 BOTTOMBORDER ← BOTTOMBORDERDEFAULT ; TOPBORDER ← TOPBORDERDEFAULT ; TES 1/26/75 ;
01000 SETDEVICEPARAMETERS(ABS(DEVICE)) ; TES 8/24/74 ;
01100 END "FONTS!" ;
01200 ENDC
00100 IFK PASSONE THENK
00200 PUBLIC SIMPLE PROCEDURE DDEVICE ;$"#
00300 BEGIN PASS ;
00400 RKJ: 19-AUG-74 ADDED ON BELOW;
00500 IF DEVICE GEQ 0 AND ON THEN COMMENT IF <0, WAS SET BY /SWITCH, WHICH TAKES PRECEDENCE ;
00600 BEGIN
00700 IFCR PARCVER THENC PARCMIC ENDC
00800 IF ITS(MIC) THEN DEVICE←MIC
00900 ELSE IF ITS(TTY) THEN DEVICE←TTY
01000 ELSE IF ITS(LPT) THEN DEVICE←LPT
01100 ELSE IF ITS(XGP) THEN DEVICE←XGP
01200 ELSE BEGIN WARN("=","No such device: "&THISWD) ; PASS ; RETURN END ;
01300 SETDEVICEPARAMETERS(ABS(DEVICE)) ; TES 8/24/74 ;
01400 END ;
01500 PASS ;
01600 END "DDEVICE" ;
01700 ENDC
00100 IFK PASSONE THENK
00200 PUBLIC SIMPLE PROCEDURE DFONT(BOOLEAN SELECT) ;$"#
00300 BEGIN "DFONT"
00400 INTEGER F;
00500 PASS;
00600 IFC PARCVER THENC
00700 IF ITS(EQUIVALENCE) THEN TES 10/21/74 ;
00800 WHILE TRUE DO
00900 BEGIN
01000 IF NEQUIVS<MAXNEQUIVS THEN NEQUIVS←NEQUIVS+1
01100 ELSE WARN(NULL,"Exceeded limit of " & CVS(MAXNEQUIVS) & " FONT EQUIVALENCEs") ;
01200 FOR F ← 2, XGP, MIC DO
01300 BEGIN
01400 PASS ;
01500 EQUIV[NEQUIVS,F] ← E(NULL, NULL) ;
01600 IF NOT ITSCH(<,>) THEN DONE ;
01700 END ;
01800 IF NOT ITSCH(<,>) THEN RETURN ;
01900 END ;
02000 ENDC
02100 IF LENGTH(THISWD)=1 AND THISTYPE GEQ 0 AND (F←RFONT(THISWD)) GEQ 0 THEN PASS
02200 ELSE F ← RFONT(E(NULL,NULL)) ; TES 11/29/73 ;
02300 IF F<0 THEN
02400 BEGIN WARN("=",<"Illegal font '"&F&"'">); RETURN END;
02500 IF SELECT THEN SELECTFONT(F) TES 1/22/74 ADDED OPTIONAL XGP FILENAME ;
02600 ELSE READFONT(F,E(NULL,NULL), IF ITSCH(<,>) THEN PASS&E(NULL,NULL) ELSE NULL);
02700 END "DFONT";
02800 ENDC
00100 IFK PASSONE THENK
00200 PUBLIC SIMPLE PROCEDURE DPICHAR ;$"#
00300 BEGIN TES 11/29/73 ;
00400 INTEGER KEY, IX, F, N ; STRING S ;
00500 INPICHAR ← TRUE ;
00600 S ← NULL ;
00700 PASS ;
00800 KEY ←E(NULL,NULL) ;
00900 IF ITSCH(<(>) THEN
01000 BEGIN COMMENT TURN ON ;
01100 PASS ;
01200 DO S ← S & E(NULL,NULL) UNTIL ITSCH(<)>) ;
01300 PASS ;
01400 IF ITS(WIDTH) THEN
01500 BEGIN PASS ;
01600 IF ITS(OF) THEN BEGIN PASS ; F←'177; N←CVD(E(NULL,NULL)) END
01700 ELSE BEGIN F←CVD(E(NULL,NULL)); N←F MOD '177; F←F DIV '177 END
01800 END
01900 ELSE BEGIN F←'177 ; N ← SP END ;
02000 S ← F & N & S ;
02100 END
02200 ELSE S ← NULL ; COMMENT TURN OFF ;
02300 IX ← PUSHI(PIWDS,PITYPE) ;
02400 PIKEY(IX) ← KEY ; PIVAL(IX) ← PUSHS(1, PICHAR[KEY]) ;
02500 PICHAR[KEY] ← S ;
02600 INPICHAR ← FALSE ;
02700 END "DPICHAR" ;
02800 ENDC
00100 IFK PASSONE THENK
00200 PUBLIC SIMPLE STRING PROCEDURE FONTEQUIV(STRING ABBREV) ;$"#
00300 BEGIN "FONTEQUIV" TES 10/21/74 CALLED BY OPENTOREAD ;
00400 IFCR PARCVER THENC
00500 INTEGER I, D ; STRING ALTNAME ;
00600 IF ABS(DEVICE) LEQ 2 THEN RETURN(NULL) ;
00700 ABBREV ← CAPITALIZE(ABBREV) ;
00800 FOR D ← 2, XGP+MIC-ABS(DEVICE) DO
00900 FOR I ← NEQUIVS STEP -1 UNTIL 1 DO
01000 IF EQU(EQUIV[I,D], ABBREV) THEN
01100 BEGIN
01200 ALTNAME ← EQUIV[I, ABS(DEVICE)] ;
01300 IF NULSTR(ALTNAME) THEN CONTINUE ;
01400 IF ALTNAME = "*" THEN
01500 BEGIN
01600 LOPP(ALTNAME) ;
01700 IF NOT SWDBACK THEN OUTSTR(CRLF) ; SWDBACK ← TRUE ;
01800 OUTSTR("Closest FONT to " & ABBREV & " is " & ALTNAME & CRLF) ;
01900 END ;
02000 IF EQU(ALTNAME, ABBREV) THEN CONTINUE ;
02100 RETURN(ALTNAME) ;
02200 END ;
02300 RETURN(NULL) ;
02400 ENDC
02500 END "FONTEQUIV" ;
02600 ENDC
00100 IFK PASSONE THENK
00200 PUBLIC SIMPLE STRING PROCEDURE MASH(STRING S) ;$"#
00300 BEGIN COMMENT TES 8/14/74 UNPACK 7-BIT BYES TO 64-EXCESS 4-BIT BYTES;
00400 INTEGER C ; STRING Q ;
00500 Q ← NULL ;
00600 WHILE FULSTR(S) DO
00700 BEGIN
00800 C ← LOP(S) ;
00900 Q ← Q & ((C LSH -4)+64) & ((C LAND '17)+64) ;
01000 END ;
01100 RETURN(Q) ;
01200 END ;
01300 ENDC
00100 IFK PASSONE OR PASSTWO THENK
00200 PUBLIC SIMPLE INTEGER PROCEDURE PERUSEFONT(INTEGER WHICH, CHAN) ;$"#
00300 BEGIN
00400 INTEGER I, K, FSIZE ;
00500 IFCR ITSVER THENC PJ 5/28/74 ;
00600 WORDIN(CHAN);
00700 FNTINF[WHICH]←WORDIN(CHAN);
00800 IF WHICH=DEFAULTFONT THEN BASELINE←LDB(POINT(9,FNTINF[WHICH],17));
00900 FNTINF[WHICH]←LDB(POINT(18,FNTINF[WHICH],35)); comment HEIGHT;
01000 WHILE NOT EOF DO
01100 IF (WORDIN(CHAN) LAND 1) THEN
01200 BEGIN
01300 DUMMY←LDB(POINT(18,DUMMY←WORDIN(CHAN),35));
01400 CW[DUMMY]←LDB(POINT(18,CW[DUMMY]←WORDIN(CHAN),35));
01500 END
01600 ENDC
01700 IFCR CMUXGP THENC RKJ: MODIFIED 7-nov-74;
01800 WORDIN(CHAN); COMMENT KST ID;
01900 FNTINF[WHICH]←WORDIN(CHAN); COMMENT RKJ 10-10-73;
02000 IF (DUMMY←WORDIN(CHAN)) NEQ 2 THEN
02100 BEGIN "FORMAT 1"
02200 LABEL whattakludge;
02300 IF DUMMY LAND 1 THEN GO whattakludge;
02400 WHILE NOT EOF DO
02500 IF (WORDIN(CHAN) LAND 1) THEN
02600 whattakludge: BEGIN DUMMY←WORDIN(CHAN); CW[DUMMY]←WORDIN(CHAN) END
02700 END "FORMAT 1"
02800 ELSE
02900 BEGIN "FORMAT 2"
03000 IF WHICH=DEFAULTFONT THEN BASELINE←WORDIN(CHAN) ELSE WORDIN(CHAN);
03100 ARRYIN(CHAN,CW[0],6); COMMENT UNUSED WORDS;
03200 ARRYIN(CHAN,CW[0],128); COMMENT XWD INCR,WIDTH;
03300 FOR I←0 THRU 127 DO CW[I]←CW[I] LSH -18;
03400 END "FORMAT 2";
03500 ENDC
03600 IFCR SAILVER THENC
03700 ARRYIN(CHAN,CW[0],128);
03800 FOR I ← 0 THRU 127 DO CW[I] ← IF CW[I] THEN CW[I] LSH -18 ELSE -1 ; BH 11/5/74;
03900 WORDIN(CHAN); FNTINF[WHICH]←WORDIN(CHAN);
04000 WORDIN(CHAN);
04100 IF WHICH=DEFAULTFONT THEN BASELINE←WORDIN(CHAN);
04200 ENDC
04300 IFCR PARCVER THENC
04400 BEGIN
04500 EXTERNAL INTEGER GOGTAB;
04600 INTEGER I, K ;
04700 SFBSZ(CHAN, 16) ;
04800 IF ABS(DEVICE)=MIC THEN
04900 PARCFILE
05000 ELSE BEGIN
05100 K←WORDIN(CHAN); WORDIN(CHAN);
05200 FNTINF[WHICH]←WORDIN(CHAN); WORDIN(CHAN);
05300 FOR I←1 THRU K DO WORDIN(CHAN);
05400 K←(K MIN 128)-1;
05500 FOR I←0 THRU K DO CW[I]←WORDIN(CHAN);
05600 END ;
05700 END;
05800 ENDC;
05900 RETURN(FSIZE) ;
06000 END "PERUSEFONT" ;
06100 ENDC
00100 IFK PASSONE THENK
00200 PUBLIC SIMPLE STRING PROCEDURE PICKFONT(INTEGER F) ;$"#
00300 RETURN(FONTCHAR&"F"&(IF F<10 THEN (F+"0") ELSE (F+("A"-10))));
00400 ENDC
00100 IFK PASSONE THENK
00200 PUBLIC SIMPLE PROCEDURE READFONT(INTEGER WHICH; STRING FILENAME, BFILENAME) ;$"#
00300 IF ON AND XCRIBL THEN TES 8/24/74 PROCEDURIZED AND SIMPLIFIED;
00400 BEGIN "READFONT"
00500 INTEGER SAVCW, CHAN;
00600 SAVCW ← WHATIS(CW);
00700 IF FNTFIL[WHICH] = 0 THEN FNTFIL[WHICH] ← CREATE(0,127);
00800 DUMMY ← FNTFIL[WHICH] ;
00900 IF SAVCW=WCW AND WHICH=DEFAULTFONT THEN SAVCW←DUMMY;
01000 MAKEBE(DUMMY,CW);
01100 CHAN ← OPENTOREAD('14, "Font file ", FILENAME,
01200 FONTEXT, FONTPPN) ;
01300 PERUSEFONT(WHICH, CHAN) ;
01400 IF NULSTR(BFILENAME) THEN TES Didn't specify special name for XGP driver ;
01500 IFCR TENEX THENC
01600 BEGIN STRING NAME, EXT, PPN ;
01700 NAME←CVFIL(FILENAME,EXT,PPN) ;
01800 BFILENAME ← NAME & EXT ;
01900 END ;
02000 ELSEC
02100 BFILENAME ← FILENAME ;
02200 ENDC
02300 XFNTNAME[WHICH] ← BFILENAME ;
02400 FNTNAME[WHICH] ← FILENAME ;
02500 IFCR SAILVER THENC
02600 BEGIN INTEGER NAME, EXT, PPN ;
02700 COMMENT BH 12/13/74 TO FLUSH .FNT[XGP,SYS] FROM .XGP FILE ;
02800 NAME←CVFIL(FILENAME,EXT,PPN) ;
02900 IF EXT=FONTEXT THEN EXT←0 ;
03000 IF PPN=FONTPPN THEN PPN←0 ;
03100 CMDFILE ← CMDFILE & "/FONT#" & CVS(WHICH-1) & "=" &
03200 UNCVFIL (0,NAME,EXT,PPN) ;
03300 END
03400 ENDC;
03500 HIFONT ← WHICH MAX HIFONT ; LOFONT ← WHICH MIN LOFONT ; TES 8/24/74 ;
03600 RELEASE(CHAN);
03700 MAKEBE(SAVCW,CW);
03800 END "READFONT";
03900 ENDC
00100 IFK PASSONE THENK
00200 PUBLIC SIMPLE INTEGER PROCEDURE RFONT(INTEGER F) ;$"#
00300 RETURN( TES SUBROUTINIZED AND CASED 11/29/73 ;
00400 IFCR SAILXGP THENC
00500 IF "1" LEQ F LEQ "9" THEN F-"0"
00600 ELSE IF "A" LEQ F LEQ "Z" THEN F-("A"-10)
00700 ELSE IF "a" LEQ F LEQ "z" THEN F-("a"-10)
00800 ELSE -1
00900 ENDC
01000 IFCR PARCVER THENC
01100 IF ABS(DEVICE)=XGP THEN
01200 IF "1" LEQ F LEQ "9" THEN F-"0"
01300 ELSE -1
01400 ELSE IF ABS(DEVICE)=MIC THEN
01500 IF "0" LEQ F LEQ "9" THEN F-"0"
01600 ELSE IF "A" LEQ F LEQ "F" THEN F-("A"-10)
01700 ELSE IF "a" LEQ F LEQ "f" THEN F-("a"-10)
01800 ELSE -1
01900 ELSE 1
02000 ENDC
02100 IFCR CMUXGP THENC
02200 IF "A" LEQ F LEQ "B" THEN F-("A"-10)
02300 ELSE IF "a" LEQ F LEQ "b" THEN F-("a"-10)
02400 ELSE IF "1" LEQ F LEQ "2" THEN F-"0"
02500 ELSE -1
02600 ENDC
02700 ) ;
02800 ENDC
00100 IFK PASSONE THENK
00200 PUBLIC SIMPLE PROCEDURE SELECTFONT(INTEGER WHICH) ;$"#
00300 IF ON THEN
00400 BEGIN "SELECTFONT"
00500 INTEGER F;
00600 DBREAK;
00700 IF NOT XCRIBL OR LAST<4 THEN RETURN;
00800 F←(IF WHICH<10 THEN (WHICH+"0") ELSE (WHICH+("A"-10)));
00900 IF FNTFIL[WHICH]=0 THEN BEGIN WARN("=",<"Unknown font '"& F & "'">);
01000 RETURN END;
01100 SWITCHFONT(WHICH) ; TES 11/14/73 SUBROUTINIZED ;
01200 END "SELECTFONT";
01300 ENDC
00100 IFK PASSONE THENK
00200 PUBLIC SIMPLE PROCEDURE SWITCHFONT(INTEGER WHICH) ;$"#
00300 BEGIN TES 11/15/73 TO DO IT BY AREA ;
00400 INTEGER NEWIX ;
00500 IF AREAIXM AND FONTSIX(AREAIXM) < OLDIHED THEN
00600 BEGIN TES FIRST CHANGE IN THIS BLOCK IN THIS AREA ;
00700 NEWIX ← PUSHI(FONTWDS, FONTYPE) ;
00800 AREAX(NEWIX) ← AREAIXM ;
00900 OUTERX(NEWIX) ← FONTSIX(AREAIXM) ;
01000 THISFONTX(NEWIX) ← THISFONT ;
01100 OLDFONTX(NEWIX) ← OLDFONT ;
01200 FONTSIX(AREAIXM) ← NEWIX ;
01300 END ;
01400 OLDFONT ← THISFONT;
01500 IF THISFONT NEQ WHICH THEN
01600 BEGIN
01700 THISFONT ← WHICH;
01800 WHICH ← FNTFIL[WHICH]; MAKEBE(WHICH,CW);
01900 END ;
02000 END ;
02100 ENDC
00100 IFK PASSONE THENK
00200 PUBLIC SIMPLE PROCEDURE SETDEVICEPARAMETERS(INTEGER DEVICE) ;$"#
00300 BEGIN TES 8/24/74 ;
00400 STRING ABBREV, EQD ;
00500 DEFINE GETS = [← CASE DEVICE-1 OF];
00600 COMMENT DEVICES 1=LPT 2=TTY 3=MIC 4=XGP ;
00700 COMMENT ----- ----- ----- ----- ;
00800 CHARW GETS (1, 1, 40, 16) ;
00900 MINCHARW GETS (1, 1, 0, IFC SAILVER THENC 0 ELSEC 1 ENDC) ;
01000 XCRIBL GETS (FALSE, FALSE, TRUE, TRUE) ;
01100 VBPI GETS (6, 6, VBPIMIC, VBPIXGP) ;
01200 HBPI GETS (10, 10, HBPIMIC, HBPIXGP) ;
01300 MINLFTMAR GETS (0, 0, MICMINLFTMAR, XGPMINLFTMAR) ;
01400 VUNDERLINE GETS (BAR,
01500 IFC PARCVER THENC NULL ELSEC BAR ENDC,
01600 BAR, BAR) ;
01700 IFC CMUVER THENC
01800 IF XCRIBL AND NULSTR(FNTNAME[1]) THEN
01900 BEGIN
02000 READFONT(DEFAULTFONT,"NGR25.KST[A730KS00]",NULL);
02100 END ;
02200 ENDC
02300 END "SETDEVICEPARAMETERS" ;
02400 ENDC
00100 IFK PASSONE THENK
00200 PUBLIC STRING SIMPLE PROCEDURE TRUNCATE(STRING STR; INTEGER LEN) ;$"#
00300 BEGIN "TRUNCATE" COMMENT RETURN INITIAL SUBSTRING OF STR OF XLEN LEQ LEN ;
00400 STRING S; INTEGER I,L;
00500 S←STR; I←L←0;
00600 WHILE FULSTR(S) DO
00700 BEGIN
00800 IF (L←L+CW[LOP(S)])>LEN THEN RETURN(STR[1 TO I]);
00900 I←I+1;
01000 END;
01100 RETURN(STR);
01200 END "TRUNCATE";
01300 ENDC
00100 IFK PASSONE THENK
00200 PUBLIC INTEGER SIMPLE PROCEDURE XLENGTH(STRING CHARS) ;$"#
00300 BEGIN "XL"
00400 INTEGER COUNT,CH,W,MAXCHARW;
00500 IF NOT XCRIBL THEN RETURN(0); COMMENT IF NOT IN XCRIBL MODE THEN WE DON'T NEED THIS VALUE;
00600 IF NOT ON THEN RETURN(0) ; TES 10/20/74 ;
00700 COUNT←0; MAXCHARW←XMAXIM; TES 8/24/74 ;
00800 WHILE FULSTR(CHARS) DO
00900 IFCR SAILVER OR PARCVER THENC
01000 BEGIN TES 8/14/74, HOW ABOUT CMU & ITS ? ;
01100 IF MINCHARW LEQ (W← CW[ CH←LOP(CHARS) ]) LEQ MAXCHARW THEN
01200 COUNT ← COUNT + W
01300 ELSE WARN("Bad FONT char", <"The character '" & CVOS(CH) &
01400 " has an unusual FONT width " & CVS(W) &
01500 (IF NULSTR(FNTNAME[THISFONT]) THEN CRLF & "because you forgot to declare FONT "
01600 ELSE " in " & FNTNAME[THISFONT] & " FONT ") &
01700 PICKFONT(THISFONT)[3 TO 3]>) ;
01800 END ;
01900 ELSEC
02000 COUNT ← COUNT + CW[LOP(CHARS)];
02100 ENDC
02200 RETURN (COUNT);
02300 END;
02400 ENDC
00100 IFK PASSONE THENK
00200 PUBLIC INTEGER SIMPLE PROCEDURE XSPLEN(INTEGER N) ;$"#
00300 RETURN(N * CW[SP]);
00400 ENDC
00100 IFK PASSONE THENK
00200
00300 FINISHED
00400
00500 ENDOF("FONTS")
00600
00700 ENDC